perm filename LOOP.FAI[NEW,LCS]8 blob
sn#310921 filedate 1977-10-16 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE LOOP SUBROUTINE LOOP(I,J,L,M,N)
C00045 ENDMK
C⊗;
TITLE LOOP ; SUBROUTINE LOOP(I,J,L,M,N)
ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO
ENTRY SORT2,UPDATE,NEWR,MSSLUP,LUP2,HOMER,FSCAN,NALF,BOX,PARCH
ENTRY CODN
EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM
EXTERNAL SC,SCX,RRJJ,STF,ALF,POSI,RMOD,RINP,SIZ,HOMX
EXTERNAL RHORZ,SETCUR,DPYSET,DPYBRT,SETPOG,ALINE
; DIMENSION N(1)
MM←1 ↔ NN←2 ↔ JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13
RC←14 ↔ NX←15 ;**** AC'S 0,1,2,3,5 ARE USED IN 'PLACE' & 'FINDIT'!!
LOOP: 0 ; DO 1 NN=I+L,J+L,K
MOVE 1,@4(16)
SUB 1,@3(16) ; MM IS IN 1
MOVE 2,@(16)
ADD 2,@3(16) ;I+L -- NN, 1ST TIME
MOVE 3,@1(16)
ADD 3,@3(16) ;J+L
MOVE 4,@2(16) ;K
HRRZI 5,@5(16) ; ADR. OF N
ADDI 2,-1(5) ; N(NN)
ADDI 3,-1(5)
JUMPL 4,LP3 ; JUMP IF NEG. INCR.
HRRM 1,.+1 ; ADD IN MM
LP1: MOVE 6,(2)
MOVEM 6,(2) ;N(NN)=N(NN+MM)
CAIGE 2,(3)
AOJA 2,LP1
JRA 16,6(16)
LP3: HRRM 1,.+1
LP2: MOVE 6,(2) ;NEG. INCR.
MOVEM 6,(2)
CAILE 2,(3)
SOJA 2,LP2
JRA 16,6(16) ; END
PLACE: 0 ; FUNCTION PLACE(X)
; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
; EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
MOVN 2,@(16) ; PLACE=R11-ABS(RD-X)
FADR 2,RMOD+=9 ;END
MOVMS 2
MOVE 0,.COMM.+=12 ;R11
FSBR 0,2
JRA 16,1(16)
FINDIT: 0 ; FUNCTION FINDIT(N)
SETZ ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
HRRZ 1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
;; HRRZI 2,PTR ; FINDIT=0
;; ADDI 1,(2) ; L=PWDS(N)
;; MOVE 2,-1(1) ; IF(RN(L+1).NE.1)GO TO 377
;; FIXX(2) ; IF(RN(L+2).EQ.R2)RETURN
;; HRRZI 3,XRN ;377 FINDIT=-1
;; ADDI 3,(2) ; END
;; MOVE 5,(3) ; RN(L+1)
MOVE 2,PTR-1(1) ;THESE 3 REPLACE ABOVE
MOVE 5,XRN(2)
CAME 5,[1.0]
JRST FNEG
MOVEM 2,PTR+=251 ; SENDS BACK A NUM IN L
;; MOVE 5,1(3) ;RN(L+2)
MOVE 5,XRN+1(2)
CAME 5,.COMM.
FNEG: SETO
JRA 16,1(16)
DPYNEW: 0 ; SUBROUTINE DPYNEW
JSA 16,ACCPOG ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
JUMP [1] ; CALL ACCPOG(1)
MOVE 2,DPY+=4251 ; IF(IGO.GT.0)RETURN
JUMPG 2,DB ; CALL DPYOUT(1)
JSA 16,DPYOUT ; END
JUMP [1]
DB: JRA 16,(16)
MVBEAM: 0 ;C THESE MOVE ENDS OF PARTIAL INNER BEAMS.
HRRZ 2,(16) ; SUBROUTINE MVBEAM(R,I,JY,L,W)
ADD 2,@1(16) ; +I
MOVE 3,2 ;C L AND JY ARE FOR MOVES TO DIFF. STAFF.
ADD 2,@2(16) ; +JY DIMENSION R(1)
MOVE 2,-1(2) ; Y=R(JY+I)
; Z=ABS(Y)
; IF(Z.LT.100.)GO TO 1
; IF(I.GT.5)GO TO 1
;C NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
; Y=AMOD(Y,100.)
; Z=Z-ABS(Y)+ABS(X)
; IF(X)Z=-Z
; GO TO 2
FADR 2,@4(16) ;1 Z=Y+W
ADD 3,@3(16) ; +L
MOVEM 2,-1(3) ; PUT IT IN R(L+I)
JRA 16,5(16) ; END
MVBX: 0 ; SUBROUTINE MVBX(I)
; COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
HRRZI 1,XRN ; LOC OF XRN
ADD 1,@(16) ; EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
MOVE 2,1
ADD 2,KJY+1 ; R(L+I)=R8+(R(JY+I)-R4)*RDIS
MOVE 3,-1(2)
FSBR 3,.COMM.+5
FMPR 3,.COMM.+=25 ; *RDIS
FADR 3,.COMM.+=9 ; +R8
ADD 1,.COMM.+=24 ; + L
MOVEM 3,-1(1)
JRA 16,1(16)
JUGGLE: 0 ; SUBROUTINE JUGGLE
; IMPLICIT INTEGER(A-Z)
; REAL PWDS,RN
; COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
; COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
SOS PTR+=250 ;ITEM=ITEM-1
HRRZI 15,XRN ; JX=RN(MEDIT)+3 WD CNT OF OLD ITEM
ADD 15,DPY+=4250 ;C I-IX IS WD CNT OF NEW ITEM
KIFIX 14,-1(15) ;MOVE 14,-1(15)
ADDI 14,3 ; JX
MOVE 13,PTR+=253 ;JY=IX
MOVE 11,PTR+=252 ; I
SUB 11,13
SUB 11,14 ;Z=I-IX-JX SPACE CHANGE
JUMPL 11,J2751 ;IF(Z)2751,172,751
JUMPE 11,J172
MOVE 5,PTR+=252 ;751 CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
SUBI 5,1
MOVE 10,DPY+=4250
ADD 10,14
JSA 16,LOOP
JUMP 5
JUMP 10
JUMP [-1]
JUMP 11
JUMP [0]
JUMP XRN
ADD 13,11 ;JY=IX+Z
JRST J172 ;GO TO 172
J2751: ADD 14,DPY+=4250 ;2751 CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
ADD 14,11
MOVE 5,11
ADD 5,PTR+=253
SOJ 5,
MOVN 10,11
JSA 16,LOOP
JUMP 14
JUMP 5
JUMP [1]
JUMP [0]
JUMP 10
JUMP XRN
;172 J=RN(JY)+2
J172: KIFIX 12,XRN-1(13) ;MOVE 12,XRN-1(13)
ADDI 12,2 ; J IS IN 12
JSA 16,LOOP ;CALL LOOP(0,J,1,MEDIT,JY,RN)
JUMP [0]
JUMP 12
JUMP [1]
JUMP DPY+=4250 ; MEDIT
JUMP 13 ; JY
JUMP XRN
MOVE 12,PTR+=253 ; I=IX+Z
ADD 12,11 ; Z IS IN 11
MOVEM 12,PTR+=252
MOVE 12,PTR+=250 ; 1751 X=ITEM+1
AOJ 12, ; X IS IN 12
HRRZI 13,DPY+=4000 ; JX=WDS(X22+1)-WDS(X22)
ADD 13,DL
MOVE 14,(13) ; WDS(X22+1) IN 14 ADR. WDS(X22) IN 13
SUB 14,-1(13) ;JX IN 14
HRRZI 10,DPY+=4000 ; J=WDS(X+1)-WDS(X)
ADDI 10,(12)
MOVE 7,(10) ;WDS(X+1)
SUB 7,-1(10) ;J IN 7
MOVEM 7,MVBX ; STORE J
SUB 7,14 ; Y=J-JX
MOVE 14,-1(10) ; JX=WDS(X)+Y+1
ADD 14,7
AOJ 14, ; JX IN 14
JUMPL 7,J2851 ; IF(Y)2851,182,282
JUMPE 7,J182
MOVE 15,(10) ;282 CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
ADDI 15,2 ; ARG 1
MOVE 6,-1(13) ; ARG 2
JSA 16,LOOP
JUMP 15
JUMP 6
JUMP [-1]
JUMP 7 ; Y
JUMP [0]
JUMP DPY
JRST J182 ; GO TO 182
J2851: MOVE 14,(13) ;2851 CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
ADD 14,7 ;+Y
ADDI 14,1 ; ARG 1
MOVE 5,-1(10) ;WDS(X)
ADD 5,7
ADDI 5,1 ; ARG 2
MOVNM 7,MVBEAM ; -Y IS STORED
JSA 16,LOOP
JUMP 14
JUMP 5
JUMP [1]
JUMP [0]
JUMP MVBEAM
JUMP DPY
MOVE 14,-1(10) ; WDS(X) JX=WDS(X)+1
ADDI 14,1 ; JX IN 14
J182: MOVE 5,-1(13) ;182 CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
ADDI 5,1 ;WDS(X22)+1
JSA 16,LOOP
JUMP [1]
JUMP MVBX
JUMP [1]
JUMP 5
JUMP 14
JUMP DPY
MOVE 2,DL ; DO 183 K=X22+1,X
; 183 WDS(K)=WDS(K)+Y
HRRZI 3,PTR
ADDI 3,(2)
J183: JUMPE 11,J184 ;IF(Z.EQ.0)GO TO 184
ADDM 11,(3) ; PWDS(K)=PWDS(K)+Z
AOJ 3, ;UPDATE PWDS AND WDS
J184: JUMPE 7,J185
ADDM 7,(13)
AOJ 13,
J185: CAIGE 2,(12)
AOJA 2,J183 ;ST(2)=WDS(X)
MOVE 2,DPY+=3999(12)
MOVEM 2,DPY+1
SETZM DL ;X22=0
JRA 16,(16)
SORT2: 0 ;SUBROUTINE SORT2(RPOS,M)
MOVEI 2,2 ;DIMENSION RPOS(2,200)
S3: MOVE 6,2 ;(K=L HERE)
SETO 11, ;L=2
HRRZI 3,@(16) ;3 J=-1
MOVE 4,2 ;RX=RPOS(1,L-1)
SUBI 4,1 ;L-1
IMULI 4,2
ADDI 4,(3)
MOVE 5,-2(4) ;RX
S2: MOVE 7,6 ; DO 2 K=L,M
;IF(RPOS(1,K).GE.RX)GO TO 2
IMULI 7,2 ;IF(RPOS(1,K).GE.RX)GO TO 2
ADDI 7,(3)
CAMG 5,-2(7)
JRST S1 ; CONTINUE
MOVE 5,-2(7) ; RX=RPOS(1,K)
;;C WHY WERE ALL THE RX'S JX ????? 9/6/73
MOVE 11,6 ;J=K
S1: CAMGE 6,@1(16) ;2 CONTINUE
AOJA 6,S2
JUMPL 11,S4 ;IF(J)GO TO 4
MOVE 12,2 ;K=L-1
SOS 12
IMULI 12,2 ;(K*2)
ADD 12,3 ;CALL EXCH(RPOS(1,K),RPOS(1,J))
MOVE 10,-2(12)
IMULI 11,2
ADD 11,3
EXCH 10,-2(11)
MOVEM 10,-2(12)
MOVE 10,-1(12) ;CALL EXCH(RPOS(2,K),RPOS(2,J))
EXCH 10,-1(11)
MOVEM 10,-1(12)
S4: CAMGE 2,@1(16) ;4 L=L+1
AOJA 2,S3 ;IF(L.LE.M)GO TO 3
JRA 16,2(16) ;END
XNOTE: 0 ;FUNCTION XNOTE(J)
MOVE 3,@(16) ;COMMON/XRN/RN(4000)
IMULI 3,12 ;DIMENSION R(10,80)
;EQUIVALENCE (R,RN(3001))
;XNOTE=AMOD(R(4,J),100.)
MOVE 2,RINP-7(3)
JSA 16,AMOD
JUMP 2
JUMP [=100.0]
CAML [80.0] ;IF(XNOTE.GE.80)XNOTE=XNOTE-100
FSBR [100.0] ; FOR NEG. MINIS, ETC.
MOVE 2,RINP-1(3) ;GET R(10,J)
JUMPE 2,.+5 ;IF 0, RETURN
MOVE 3,[5.0] ; ON STF ABOVE, +5 HGT.
CAMN 2,[1.0] ; 1=STF BELOW
MOVNS 3 ; MAKE IT -5
FADR 3 ;ADD IT TO XNOTE
JRA 16,1(16) ;END
BAUTO: 0 ; SUBROUTINE BAUTO(J,L,K,N)
;C FOR AUTOMATIC BEAMS.
MOVEI 2,2 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
ADDB 2,@(16) ;J=J+2
MOVE 4,@1(16)
SUB 4,@3(16) ;L-N
MOVE 5,@2(16)
SUB 5,@3(16) ;K-N
FLTR 4,4 ;TLC 4,232000
MOVEM 4,SC+16(2) ;VX(J-1)=L-N
;**** A LIMIT OF 25 BEAMS PER LINE.
FLTR 5,5 ;TLC 5,232000
MOVEM 5,SC+17(2) ;VX(J)=K-N
JRA 16,4(16)
UPDATE: 0 ; SUBROUTINE UPDATE(I)
;; HRRZI 3,XRN ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
;; ADD 3,PTR+=252 ;RN(IS)=I
MOVE 3,PTR+=252
FLTR 2,@(16) ;MOVE 2,@(16)
MOVEM 2,XRN-1(3)
;IS=IS+I+3
MOVE 2,@(16)
ADDI 2,3
ADDM 2,PTR+=252
JRA 16,1(16)
IK: 0 ;***** DON'T USE THESE ELSEWHERE, THEY STORE NUMBS.!!
JIT: 0 ; THESE ARE TO STORE PNTRS IN LOOP
NEWR: 0 ; SUBROUTINE R
MOVE A,SC+=70 ;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
CAIE A,1 ;COMMON/XRN/RN(4000)
JRST N1 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
MOVE JK,PTR+=252;COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
MOVEM JK,IK ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
MOVE JT,PTR+=250 ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
MOVEM JT,JIT ;DIMENSION R(10,80)
N1: MOVE IS,IK ;EQUIVALENCE (R,RN(3001))
MOVEM IS,PTR+=252
MOVE 14,[9999.0]
MOVE JT,JIT ;IF(MODE.NE.1)GO TO 1
ADDI JT,1 ;IK=IS
MOVEM JT,PTR+=250 ;HOMER=ITEM
MOVEI K,=10 ;1 IS=IK
MOVE IZ,SCX+=41 ;ITEM=HOMER+1 ******************** WAS +=33
IMULI IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
;;N2: HRRZI R,XRN+=2997 ;DO 2 K=1,IZ
;;;;N2: MOVE R,XRN+=2997(K) ;DO 2 K=1,IZ
;; ADD R,K ;IF(R(8,K).EQ.9999.)GO TO 2
N2: CAMN 14,RINP-3(K)
JRST NN2 ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
SETO IEND, ;C JUMP FOR BEAM CONT.
;; HRRZI L,XRN ;IEND=-1
MOVE IS,RINP-=10(K) ;GET CODE NUM. FROM R(1,K)
CAMN IS,[1.0] ;IF IT IS 1, IEND=0
SETZ IEND,
MOVE L,PTR+=252 ;RN(IS+3)=0
SETZM XRN+2(L) ;RN(IS+2)=0
SETZM XRN+1(L)
;; SETZM LOOP ;LOOP=0 FOR P2→P11 TRANSFER
MOVEI L,=10 ;C ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
MOVE A,SC+=70 ;LK=10 IF(MODE.GT.3)L=7
CAIL A,4
MOVEI L,7 ;ONLY LOOK AT 7 PARAMS AFTER MODE 3.
N3: HRRZI R,RINP(K) ;DO 3 L=LK,1,-1
ADDI R,(L) ;A=R(L,K)
MOVE A,-13(R) ;(OCTAL) =13
JUMPGE IEND,NX4 ;IF(A.NE.0)GO TO 77
JUMPN A,NX3 ;IF(IEND)GO TO 3
JRST NN3
NX3: MOVE IEND,L ;77 IF(IEND)IEND=L
NX4: MOVE R,PTR+=252
ADDI R,(L)
MOVEM A,XRN-1(R) ;RN(IS+L)=A
NN3: CAILE L,1 ;3 CONTINUE
SOJA L,N3
MOVE A,SCM+=80 ;A=STAFF #
MOVEM A,XRN(R) ;PUT IT IN P2
CAME IS,[1.0] ;IF NOT CODE 1, SKIP OVER
JRST N4
MOVEI IEND,=11 ;SET WDCNT
MOVE A, RINP-9(K) ;GET WHAT'S IN R(2,K)
MOVEM A,XRN+=9(R) ;PUT IT IN P11
;;N4: SKIPE A,LOOP
;; MOVEM A,XRN+=9(R) ;IF(LOOP.NE.0)RN(IS+11)=LOOP (REAL)
N4: CAIGE IEND,3
MOVEI IEND,3
MOVE 15,IEND ;IF(IEND.LT.3)IEND=3
SUBI 15,2
MOVE SC+=70 ;IF(A NOTE AND MODE.EQ.3)R(9,K)=PTR TO P11 OF NT.
CAMN IS,[1.0]
CAIE 3
JRST NN4
MOVE 0,R
ADDI =10
FLTR 0 ;USE THIS IN SLUR ROUTINE
MOVEM RINP-2(K)
NN4: JSA 16,UPDATE ;CALL UPDATE(IEND-2)
JUMP 15
NN2: CAML K,IZ ;2 CONTINUE
JRA 16,(16) ;END
ADDI K,=10
JRST N2
CNT: 0
MSSLUP: 0
SETZ 1, ;161 CNT=1
SETZ 2,
L5543: MOVE 3,.COMM.+4(2) ;DO 5543 K=1,10
;; MOVE 3,(3) ;RA=RJQ(K)
SKIPE 3 ;IF(RA.NE.0)CNT=K
MOVE 1,2
;; MOVEI 4,RRJJ+1 ;5543 RJJ(K)=RA
MOVEM 3,RRJJ+1(2)
CAIG 2,=8 ; LOOP BACK?
AOJA 2,L5543
AOJ 1, ;********* WILL SAVE UP TO PARAM 12 ONLY!
MOVEM 1,CNT ;REMEMBERS CNT
JRA 16,(16)
LUP2: 0
;; MOVEI 1,XRN ;261 RN(I)=CNT
;; ADD 1,PTR+=252
FLTR 2,CNT ;MOVE 2,CNT
MOVE 1,PTR+=252
MOVEM 2,XRN-1(1)
FLTR 2,.COMM.+1 ;MOVE 2,.COMM.+1 ;RN(I+1)=JA
;I=I+2
MOVEM 2,XRN(1)
ADDI 1,2
MOVEM 1,PTR+=252
MOVE 3,.COMM. ;RN(I)=R2
MOVEM 3,XRN-1(1)
;; NOT USED NOW! IF(RD.NE.0)RN(I)=RD
;;C TO SAVE NOTE NUMBS IN P2.
SETZ 5, ;DO 4554 K=1,CNT
L4554: MOVE 2,.COMM.+4(5)
;;L4554: MOVEI 2,.COMM.+4 ;(RJQ)
;; MOVEM 2,(3) ;4554 RN(I+K)=RJQ(K)
MOVE 3,1
ADDI 3,(5)
MOVEM 2,XRN(3)
AOJ 5,
CAME 5,CNT
JRST L4554
AOJ 5,
ADDM 5,PTR+=252 ;3554 I=CNT+1+I
JRA 16,(16)
;;C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
;; SUBROUTINE HOMER
;; IMPLICIT INTEGER(A-Q,S-Z)
;; REAL PWDS,DISX,A,B,PLACE,STFF
;; COMMON /STF/RSTFAC(-3/4),RSTJ2
;; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
;; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
;; COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
;; EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
;; 1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
;; 1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
HOMER: 0 ; IF(JA.EQ.6)GO TO 9
MOVE MM,.COMM.+1
CAIN MM,6
JRST H9
SKIPE .COMM.+=14 ;IF(R13.NE.0)GO TO 10
JRST H10 ; FOR GENL HOMING; WORDS; BEAMS; STEMS;
; ALF+=14= IS = WIDTH OF NOTE -- NEEDED BECAUSE OF DIFF. STEM DIRECTIONS.
; NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
JSA 16,HOMX
JRA 16,(16)
H9: SKIPGE .COMM.+=32 ;9 IF(J11.LT.0)RETURN
JRA 16,(16) ; IF P11=-1 NO HOMING
MOVM R,.COMM.+=28 ; X=IABS(J7)/10 CC X=R7/10.
IDIVI R,=10 ;;;FDVR R,[=10.0]
SKIPN 2,.COMM.+=31 ;IF(J10.EQ.0)GO TO H100
JRST H100
CAIL 2,=10 ;IF(J10.GE.10)X=0 (=LOOK AT ALL STEM DIRS.)
SETZ R,
H100: MOVEM R,XNOTE ;X SAVED IN XNOTE = STEM DIR. OF BEAM.
; R9= POS3
;XXX MOVNI RC,1 ;RC=-1
;XXX SKIPE .COMM.+=10 ;IF(R9.NE.0)RC=-2 ****OR .GT. *******
;XXX MOVNI RC,2
;??? MOVE .COMM.+=11 ;GET P10
;??? JUMPE H10 ;IGNORE IF 0
;CCC SKIPLE .COMM.+=8 ; SKIP IF R7 IS .LE.0
;CCC MOVNI RC,3 ; RC=0 ESCAPES FRCOM LOOP.
; HOMING RANGE FOR BEAMS
H10: MOVE IS,.COMM.+=12 ;10 IF(R11.EQ.0)R11=2.9
JUMPN IS,HX10
MOVE IS,[=2.9]
MOVEM IS,.COMM.+=12 ; IF P11.NE.0 RANGE IS CHANGED FROM 2
;XXHX10: MOVE IZ,.COMM.+1 ; IF(JA.EQ.5)RC=-1
;XXX CAIN IZ,5
;XXX MOVNI RC,1
HX10: MOVEI K,1
MOVE L,.COMM.+1 ; JA IS NOW IN L
H361: JSA 16,FINDIT ;DO 361 K=1,ITEM
JUMP K
JUMPL 0,HX361 ;IF(FINDIT(K))GO TO 361
; SKIPS NOTES ON WRONG LINE
MOVEI R,XRN ;RD=RN(L+3)
ADD R,PTR+=251 ;LOC OF RN(L+1)
MOVE A,2(R) ;RD IN A
MOVEM A,RMOD+=9 ;1 IF(JA.NE.6)GO TO 177
CAIE L,6
JRST H177
KIFIX JK,4(R) ;IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
IDIVI JK,=10 ;JK=NOTE'S STEM DIRECTION
JUMPE JK,HX361 ;IF(RN(L+5).LT.10)GO TO HX361 (NO STEM)
SKIPN XNOTE ;IF(XNOTE.EQ.0)GO TO H177
JRST H177 ;XNOTE=0 = CHECK ALL STEM DIRS.
CAMN JK,XNOTE ;ARE STEM DIR,S SAME?
JRST H377 ;YES, JUMP
MOVE -1(R)
CAML [8.0]
SKIPN JT, =9(R) ;JT='OTHER STAFF' INFO 2=↑ 1=↓
SKIPA
JRST HH377 ;IF(RN(L+10).EQ.0)GO TO H377
MOVE .COMM.+5 ;LEFT HEIGHT OF BEAM
FADR .COMM.+6 ;RIGHT HEIGHT
FDVR [2.0] ;AVERAGE HEIGHT OF BEAM
FSBR 3(R) ;SUBTR HEIGHT OF NOTE
CAIE JK,1 ;IF NOTE STEM DOWN, REVERSE SIGN
MOVNS
CAMG [8.0] ; IF DIFF. IS LESS THAN 8 DON'T HOOK BEAM TO STEM.
JRST H377
;; SKIPN XNOTE ;IF(XNOTE.EQ.0)GO TO H177
;; JRST H177 ;XNOTE=0 = CHECK ALL STEM DIRS.
;; MOVE -1(R)
;; CAML [8.0]
;; SKIPN JT, =9(R) ;JT='OTHER STAFF' INFO 2=↑ 1=↓
;; JRST H377 ;IF(RN(L+10).EQ.0)GO TO H377
;; CAMN JK,XNOTE
;; JRST H377
HH377: MOVE 1,[2.44]
FMPR 1,STF+=8 ;*RSTJ2
MOVM NN,.COMM.+=25 ;IF(ABS(J4.GE.100) *.6 (MINI)
CAIL NN,=90
FMPR 1,[0.6]
CAIE JK,1
MOVNS 1
FADR A,1 ; ADD OR SUB. NOTE WIDTH FROM NOTE POS.
JRST H177 ;ALL NOTES ON 'DIFF. STF' ARE CONSIDERED.
H377: CAME JK,XNOTE
JRST HX361
H177: JSA 16,PLACE ;177 IF(PLACE(R3))GO TO 461
JUMP .COMM.+4
JUMPL H461
SETOM IZ
HX2: MOVE 5(R) ;GET PARAM 6
CAMGE [10.0] ; MUST BE .GE.10
JRST HX1
MOVE IS,[2.44] ; SIZE OF A NOTE
CAML [20.0] ; 10 = RIGHT SHIFT, 20 = LEFT SHIFT
MOVNS IS
MOVM 3(R) ; GET P4
CAML [100.0] ; IS IT A MINI?
CAML [200.0]
SKIPA
FMPR IS,[0.6] ;*RMINI
MOVE 1,.COMM.+3 ;STAFF #
FMPR IS,STF(1) ;*RSTFAC(J2)
FADR A,IS
HX1: JUMPG IZ,HX8 ; JUMP TO CHANGE P6, 8 OR 9
HX3: MOVEM A,.COMM.+4 ;R3=RD
; LOOKS FOR NOTE, STAFF #, STEM DIR.
MOVN .COMM.+=14 ;P13=-1 HOME TO NOTE SIDE, =-2 TO STEM.
SKIPG ;IS IT NEG.
JRST H11 ; NO, GO TO NEXT SECTION.
MOVE IS,3(R) ; VERTICAL POS OF NOTE (P4)
CAME [1.0] ;IS P13 -1 OR -2?
JRST H12 ;IT'S -2
MOVE [2.0]
CAMGE JK,[20.0] ;WHICH WAY IS STEM?
MOVNS
FADR IS ;ADD NOTE LEVEL
MOVEM .COMM.+5 ;P4=NOTE LEVEL + OR - 2.
JRST H11
H12: MOVE IZ,7(R) ; STEM LENGTH
CAMN IZ,[999.0] ; WHAT ABOUT 16TH AND 32ND NOTES??
SETZ IZ,
FADR IZ,[8.0]
JSA 16,AMOD
JUMP 6(R)
JUMP [10.0] ;AC0=AMOD(R7,10.0)
SKIPN
JRST H13
FSBR [1.0] ;IGNORE 1ST TAIL
FMPR [1.8] ; *SPACE FOR EACH TAIL
FADR IZ, ; ADD TO STEM LENGTH
H13: CAML JK,[20.0]
MOVNS IZ ;PUT IT UPSIDE DOWN.
FADR IS,IZ ;ADD NOTE LEVEL
MOVEM IS,.COMM.+5 ;PUT IT BEYOND STEM
H11: CAIN L,6 ;IF(JA.EQ.6)GO TO 861
JRST H861
CAIN L,5 ;IF(JA.EQ.5)GO TO 261
JRST HX361
;XXX JRST H261
JRA 16,(16) ;RETURN
H461: CAIN L,6 ;461 IF(JA.EQ.6)GO TO 277
JRST H277
CAIE L,5 ;IF(JA.NE.5)GO TO 361
JRST HX361
H277: JSA 16,PLACE ;277 IF(PLACE(R6))GO TO 561
JUMP .COMM.+7
JUMPL H561
MOVEI IZ,7 ;R6=RD
JRST HX2
H861: MOVE 0,.COMM.+=28 ;861 IF(J7.GE.0)GO TO 261
JUMPGE 0,HX361
;XXX JUMPGE 0,H261
H561: JSA 16,PLACE ;561 IF(PLACE(R9))GO TO 661
JUMP .COMM.+=10 ;R9
JUMPL H661
MOVE 0,.COMM.+=28 ;IF(J7)GO TO 761
JUMPL H761 ; J7=NEG MEANS TREMOLO
MOVE 0,.COMM.+=9 ; IF(R8.NE.0)GO TO 761
JUMPN H761
MOVE 0,.COMM.+=11 ; IF(R10.EQ.0)GO TO 361
JUMPE HX361
H761: MOVEI IZ,=10 ;761 R9=RD
JRST HX2
; R8=0, R10=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM. ; GO TO 261
H661: CAIN L,5 ;661 IF(JA.EQ.5)GO TO 361
JRST HX361
;; MOVE 0,.COMM.+=31 ;IF(J10.LT.30)GO TO 361
;; CAIGE 0,=30
SKIPN .COMM.+=31 ;IF J10.EQ.0 GO TO 361
JRST HX361
JSA 16,PLACE ;IF(PLACE(R8))GO TO 361
JUMP .COMM.+=9
JUMPL HX361 ; HOMES INNER PARTIAL BEAMS
MOVEI IZ,=9 ;R8=RD
JRST HX2
HX8: MOVEM A,.COMM.(IZ) ;PUT A INTO RIGHT PARAM.
;XXXH261: SKIPN RC ;261 IF(RC.EQ.0)RETURN
;XXX JRA 16,(16)
;XXX AOJ RC ;RC=RC+1
HX361: CAMGE K,PTR+=250 ;361 CONTINUE
AOJA K,H361
JRA 16,(16) ; END
CODN: 0 ;FUNCTION CODN(K,N)
MOVE 1,@(16) ;GET CODE NUMBER AND RETURN POINTER
MOVE 2,PTR-1(1) ;L=KWDS(K)
MOVEM 2,@1(16)
MOVE XRN(2) ;CODN=RN(L+1)
JRA 16,2(16)
FSCAN: 0
INCHRW
MOVE 2,[ASCII/ /]
MOVEM 2,ALF
MOVE 2,[XWD ALF,ALF+1]
BLT 2,ALF+=71 ; CLEANS OUT INP ARRAY
CAIN ";"
JRA 16,(16)
CAIN ":"
JRA 16,1(16)
CAIN "("
JRA 16,2(16)
CAIN ")"
JRA 16,3(16)
CAIN "/"
JRA 16,4(16)
CAIN "*"
JRA 16,5(16)
CAIN "X"
JRA 16,6(16)
CAIN "C"
JRA 16,7(16)
JRA 16,8(16)
NALF: 0
MOVE 0,@(16)
JUMPGE .+4 ;IF(I.GE.0)GO TO 20
MOVE 1,[405004020100] ; J='A'=405004020100
SETO 2, ; M=-1
JRST .+3 ;GO TO 10
MOVE 1,[201004020100] ;20 J=' '=201004020100
MOVEI 2,=16 ; M=16
SUB 0,1 ;10 NALF=(I-J)/536870912-M
IDIV 0,[3777777777]
SUB 0,2
JRA 16,1(16)
BOX: 0 ;CALL BOX(I,R) SEE PLTSRT.F4 FOR FORTR. VERSION
MOVE 14,@(16) ; I IS IN 14
JUMPL 14,BX4
KIFIX 13,@1(16) ;K=R ;MOVE 13,@1(16) ; GET R
JSA 16,AMOD
JUMP XRN+3(14) ; GET REAL P4
[100.0]
CAMGE [-20.0] ;IF(P4.LT.-20)P4=P4+100
FADR [100.0] ; FOR P4=-95 ETC.
CAML [80.0] ;IF(P4.GE.80)P4=P4-100
FSBR [100.0] ; CATCHES NEG. MINIS, ETC.
FMPR [7.0]
FMPR STF(13) ;*STAFF FACTOR
FADR POSI(13) ; + STAFF VERT. POS.
FSBR [40.0] ; SHIFT CURSOR DOWN A BIT.
FMPR SIZ
KIFIX 13,0
SUB 13,SIZ+2 ;13=K
JSA 16,RHORZ ; GET HORIZ. POS.
JUMP XRN+2(14)
FMPR SIZ ;SIZ IS FOR ZOOMED IMAGES
KIFIX 12,0 ;MOVE 12, ; 12=L
SUB 12,SIZ+1
CAIL 12,=550 ; CHECK IF OUT OF BOUNDS OF CRT
MOVEI 12,=511
CAMG 12,[-=550]
MOVE 12,[-=511]
JSA 16,SETCUR
12
13
[0]
JRA 16,2(16) ; THE CURSOR IS IN POSITION
BX4: CAME 14,[-1]
JRST BX5
JSA 16,DPYSET
[3]
RINP
[=100]
JSA 16,DPYBRT
[3]
BX5: MOVE 2,@1(16) ; GET R
JSA 16,RHORZ
2
FMPR SIZ
KIFIX 0,0
SUB SIZ+1
MOVM 2,
CAILE 2,=550
JRST BX6
MOVEM 0,LOOP
JSA 16,SETPOG
[3]
JSA 16,ALINE
LOOP
[-=511]
LOOP
[=511]
JSA 16,DPYOUT
[3]
BX6: JSA 16,SETPOG
[1]
JRA 16,2(16)
PARCH: 0 ;CALL PARCH(JA,JJA,RD)
MOVE 2,@(16) ;GET JA
CAIN 2,2 ;IS IT P2
JRST .+8
CAIE 2,1 ;IS IT P1
JRA 16,3(16) ;NEITHER
KIFIX 3,@2(16) ;GET RD
JUMPE 3,.+3 ; REJECTS CODE # 0.
CAIG 3,=18 ;IS PARAM .GT.18?
MOVEM 3,@1(16) ;PUT IT INTO JJA
JRA 16,3(16) ;ALL DONE
MOVE 3,@2(16) ;GET RD
CAMG 3,[7.0] ;REJECTS STAFF # .GT.7
MOVEM 3,RRJJ ; PUT IT AWAY
JRA 16,3(16)
END